home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / pcl / src-16f.lha / compiler / saptran.lisp < prev    next >
Encoding:
Text File  |  1992-02-22  |  3.9 KB  |  130 lines
  1. ;;; -*- Log: C.Log; Package: C -*-
  2. ;;;
  3. ;;; **********************************************************************
  4. ;;; This code was written as part of the CMU Common Lisp project at
  5. ;;; Carnegie Mellon University, and has been placed in the public domain.
  6. ;;; If you want to use this code or any part of CMU Common Lisp, please contact
  7. ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
  8. ;;;
  9. (ext:file-comment
  10.   "$Header: saptran.lisp,v 1.2 92/02/21 22:01:32 wlott Exp $")
  11. ;;;
  12. ;;; **********************************************************************
  13. ;;;
  14. ;;; This file contains some magic hacks for optimizing SAP operations.
  15. ;;;
  16. ;;; Written by William Lott.
  17. ;;;
  18. (in-package "C")
  19.  
  20.  
  21.  
  22. ;;;; Defknowns
  23.  
  24.     
  25. (defknown foreign-symbol-address (simple-string) system-area-pointer
  26.   (movable flushable))
  27.  
  28. (defknown (sap< sap<= sap= sap>= sap>)
  29.       (system-area-pointer system-area-pointer) boolean
  30.   (movable flushable))
  31.  
  32. (defknown sap+ (system-area-pointer integer) system-area-pointer
  33.   (movable flushable))
  34. (defknown sap- (system-area-pointer system-area-pointer) (signed-byte 32)
  35.   (movable flushable))
  36.  
  37. (defknown sap-int (system-area-pointer) (unsigned-byte 32) (movable flushable))
  38. (defknown int-sap ((unsigned-byte 32)) system-area-pointer (movable))
  39.  
  40.  
  41. (defknown sap-ref-8 (system-area-pointer index) (unsigned-byte 8)
  42.   (flushable))
  43. (defknown %set-sap-ref-8 (system-area-pointer index (unsigned-byte 8))
  44.   (unsigned-byte 8)
  45.   ())
  46.  
  47. (defknown sap-ref-16 (system-area-pointer index) (unsigned-byte 16)
  48.   (flushable))
  49. (defknown %set-sap-ref-16 (system-area-pointer index (unsigned-byte 16))
  50.   (unsigned-byte 16)
  51.   ())
  52.  
  53. (defknown sap-ref-32 (system-area-pointer index) (unsigned-byte 32)
  54.   (flushable))
  55. (defknown %set-sap-ref-32 (system-area-pointer index (unsigned-byte 32))
  56.   (unsigned-byte 32)
  57.   ())
  58.  
  59.  
  60. (defknown signed-sap-ref-8 (system-area-pointer index) (signed-byte 8)
  61.   (flushable))
  62. (defknown %set-signed-sap-ref-8 (system-area-pointer index (signed-byte 8))
  63.   (signed-byte 8)
  64.   ())
  65.  
  66. (defknown signed-sap-ref-16 (system-area-pointer index) (signed-byte 16)
  67.   (flushable))
  68. (defknown %set-signed-sap-ref-16 (system-area-pointer index (signed-byte 16))
  69.   (signed-byte 16)
  70.   ())
  71.  
  72. (defknown signed-sap-ref-32 (system-area-pointer index) (signed-byte 32)
  73.   (flushable))
  74. (defknown %set-signed-sap-ref-32 (system-area-pointer index (signed-byte 32))
  75.   (signed-byte 32)
  76.   ())
  77.  
  78.  
  79. (defknown sap-ref-sap (system-area-pointer index) system-area-pointer
  80.   (flushable))
  81. (defknown %set-sap-ref-sap (system-area-pointer index system-area-pointer)
  82.   system-area-pointer
  83.   ())
  84.  
  85. (defknown sap-ref-single (system-area-pointer index) single-float
  86.   (flushable))
  87. (defknown sap-ref-double (system-area-pointer index) double-float
  88.   (flushable))
  89.  
  90. (defknown %set-sap-ref-single
  91.       (system-area-pointer index single-float) single-float
  92.   ())
  93. (defknown %set-sap-ref-double
  94.       (system-area-pointer index double-float) double-float
  95.   ())
  96.  
  97.  
  98. ;;;; Transforms for converting sap relation operators.
  99.  
  100. (loop
  101.   for (sap-fun int-fun) in '((sap< <) (sap<= <=) (sap= =) (sap>= >=) (sap> >))
  102.   do (deftransform sap-fun ((x y) '* '* :eval-name t)
  103.        `(,int-fun (sap-int x) (sap-int y))))
  104.  
  105.  
  106. ;;;; Transforms for optimizing sap+
  107.  
  108. (deftransform sap+ ((sap offset))
  109.   (cond ((and (constant-continuation-p offset)
  110.           (eql (continuation-value offset) 0))
  111.      'sap)
  112.     (t
  113.      (extract-function-args sap 'sap+ 2)
  114.      '(lambda (sap offset1 offset2)
  115.         (sap+ sap (+ offset1 offset2))))))
  116.  
  117. (dolist (fun '(sap-ref-8 %set-sap-ref-8
  118.            signed-sap-ref-8 %set-signed-sap-ref-8
  119.            sap-ref-16 %set-sap-ref-16
  120.            signed-sap-ref-16 %set-signed-sap-ref-16
  121.            sap-ref-32 %set-sap-ref-32
  122.            signed-sap-ref-32 %set-signed-sap-ref-32
  123.            sap-ref-sap %set-sap-ref-sap
  124.            sap-ref-single %set-sap-ref-single
  125.            sap-ref-double %set-sap-ref-double))
  126.   (deftransform fun ((sap offset) '* '* :eval-name t)
  127.     (extract-function-args sap 'sap+ 2)
  128.     `(lambda (sap offset1 offset2)
  129.        (,fun sap (+ offset1 offset2)))))
  130.